Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/docume1a/docproce

Text File | 1999-09-10 | 19.7 KB | 601 lines

Attribute VB_Name = "DocProcedures"

'Functions of the document application
'Save Functions, Close Functions, and Exit
'Functions.  Created so that frmOpenDoc
'can call the functions, instead of making
'them public in the MDIForm.


'SAVE PROCEDURES
'===============

Public Function SaveEnabled()
    If boolnew = False Then
        MDIForm1.mnuSave.Enabled = True
        MDIForm1.Toolbar1.Buttons(3).Enabled = True
        MDIForm1.mnuSaveAs.Enabled = True
        MDIForm1.Toolbar1.Buttons(4).Enabled = True
    Else
        MDIForm1.mnuSaveAs.Enabled = True
        MDIForm1.Toolbar1.Buttons(4).Enabled = True
    End If
End Function
Public Function SaveDisabled()
    MDIForm1.mnuSaveAs.Enabled = False
    MDIForm1.mnuSave.Enabled = False
    MDIForm1.Toolbar1.Buttons(3).Enabled = False
    MDIForm1.Toolbar1.Buttons(4).Enabled = False
End Function
Public Function SaveDoc()
        If GetAttr(MDIForm1.CommonDialog1.filename) And vbReadOnly Then
            MsgBox MDIForm1.CommonDialog1.filename & " is a read only file. It cannot be saved."
            bCannotSave = True
            Exit Function
        End If

        If boolnew = True Then
            frmOpenDoc.RichTextBox1.SelStart = 0
            frmOpenDoc.RichTextBox1.SaveFile MDIForm1.CommonDialog2.filename
            boolsave = True
            MDIForm1.mnuSave.Enabled = False
            MDIForm1.Toolbar1.Buttons(3).Enabled = False
        Else
            frmOpenDoc.RichTextBox1.SelStart = 0
            frmOpenDoc.RichTextBox1.SaveFile MDIForm1.CommonDialog1.filename
            boolsave = False
            MDIForm1.mnuSave.Enabled = True
            MDIForm1.Toolbar1.Buttons(3).Enabled = False
        End If
End Function
Public Function SaveNew()
    On Error GoTo ErrHandler
    MDIForm1.CommonDialog2.Flags = &H2 'File exists
    MDIForm1.CommonDialog2.ShowSave
    frmOpenDoc.RichTextBox1.SaveFile MDIForm1.CommonDialog2.filename
    boolsave = False
    ControlsDisabled
    Exit Function
ErrHandler:
    Cancel = True
End Function
Public Function SaveAs()
    On Error GoTo ErrHandler
    MDIForm1.CommonDialog2.Flags = &H2 'File exists
    MDIForm1.CommonDialog2.ShowSave
    frmOpenDoc.RichTextBox1.SaveFile MDIForm1.CommonDialog2.filename
    boolsave = False
    boolnew = False
    frmOpenDoc.Caption = MDIForm1.CommonDialog2.filename
    MDIForm1.StatusBar1.Panels(1).Text = MDIForm1.CommonDialog2.filename
    MDIForm1.mnuPrintPreview.Enabled = True: MDIForm1.Toolbar1.Buttons(7).Enabled = True
    MDIForm1.mnuDelete.Enabled = True: MDIForm1.Toolbar1.Buttons(5).Enabled = True
    Exit Function
ErrHandler:
    Cancel = True
End Function

'CLOSING PROCEDURES
'==================

Public Function CloseNew()
Response = MsgBox("  Do You Want To Save Changes?", vbQuestion + vbYesNoCancel)
MDIForm1.CommonDialog2.CancelError = True
On Error GoTo ErrHandler
    Select Case Response
        Case vbYes
            Call SaveAs
            Call CloseNew1
        Case vbNo
            Call ControlsDisabled
            Call CloseNew1
    End Select
Exit Function
ErrHandler:
Cancel = True
End Function
Public Function CloseModExisting()
        If boolsave = True Then
            Response = MsgBox("  Do You Want To Save Changes ", vbQuestion + vbYesNoCancel)
            On Error GoTo ErrHandler
        Select Case Response
            Case vbYes
                Call SaveDoc
                If bCannotSave = False Then
                    Call CloseModExisting1
                End If
            Case vbNo
                Call CloseModExisting1
        End Select
        Else
            Call ControlsDisabled
            frmOpenDoc.RichTextBox1.Visible = False
        End If
ErrHandler:
Exit Function
End Function
Public Function CloseFile()
        If boolnew = True And boolsave = True Then
            Call CloseNew
        Else
            If boolsave = True Then
                Call CloseModExisting
            Else
                Call ControlsDisabled
                frmOpenDoc.RichTextBox1.Visible = False
            End If
        End If
End Function

'EXIT PROCEDURES
'===============

Public Function ExitDoc()
        If boolsave = True And boolnew = True Then
            Response = MsgBox("  Do You Want To Save Changes?", vbQuestion + vbYesNoCancel)
            MDIForm1.CommonDialog2.CancelError = True
            On Error GoTo ErrHandler
        Select Case Response
            Case vbYes
                Call SaveAs
                End
            Case vbNo
                End
        End Select
        Else
            If boolsave = True And boolnew = False Then
                Response = MsgBox("  Do You Want To Save Changes?", vbQuestion + vbYesNoCancel)
                MDIForm1.CommonDialog2.CancelError = True
                On Error GoTo ErrHandler
            Select Case Response
                Case vbYes
                    Call SaveDoc
                    End
                Case vbNo
                    End
            End Select
            Else
                End
            End If
        End If
ErrHandler:
Exit Function
End Function

'OPEN PROCEDURES
'===============

Public Function OpenDocument()
    Call SaveDisabled
    Dim currLine&
    boolsave = False
    boolnew = False
    MDIForm1.CommonDialog1.CancelError = True
    On Error GoTo ErrHandler
    MDIForm1.CommonDialog1.ShowOpen
    Screen.MousePointer = 11
    DoEvents 'added to hide the Open dialog while loading.
    MDIForm1.StatusBar1.Panels(1).Text = "Loading file, please wait..."
    frmOpenDoc.Visible = True
    frmOpenDoc.RichTextBox1.Visible = True
    frmOpenDoc.WindowState = 0
    frmOpenDoc.Width = Screen.Width * 0.89 ' Set width of form.
    frmOpenDoc.Height = Screen.Height * 0.61   ' Set height of form.
    frmOpenDoc.RichTextBox1.LoadFile MDIForm1.CommonDialog1.filename
    DoEvents
    currLine& = SendMessageLong(frmOpenDoc.RichTextBox1.hwnd, EM_LINEFROMCHAR, -1&, 0&) + 1
    MDIForm1.StatusBar1.Panels(4) = Format$(currLine&, "##,###")
    MDIForm1.StatusBar2.Visible = False
    frmOpenDoc.Caption = MDIForm1.CommonDialog1.filename
    frmOpenDoc.SetFocus
    MDIForm1.StatusBar1.Panels(1) = MDIForm1.CommonDialog1.filename
    Screen.MousePointer = 0
    Call ControlsEnabled
    frmFind.Hide
    frmReplace.Hide
    boolnew = False
    Exit Function
ErrHandler:
    Exit Function
End Function
Public Function OpenDocMod()
Response = MsgBox("  Do You Want To Save Changes?", vbQuestion + vbYesNoCancel)
MDIForm1.CommonDialog2.CancelError = True
On Error Resume Next
        Select Case Response
            Case vbYes
                OpenDocModify
            Case vbNo
                ControlsDisabled
                frmOpenDoc.Visible = False
                Call OpenFile
        End Select
frmFind.Hide
frmReplace.Hide
Exit Function
ErrHandler:
Exit Function
End Function
Public Function OpenFile()
        If boolnew = True And boolsave = True Then
            Call OpenDocMod
        Else
            If boolsave = True Then
                Call OpenCloseModExisting
            Else
                Call OpenDocument
            End If
        End If
End Function
Public Function OpenCloseModExisting()
        If boolnew = True And boolsave = True Then
            Call OpenDocMod
        Else
            If boolsave = True Then
                Response = MsgBox("  Do You Want To Save Changes?", vbQuestion + vbYesNoCancel)
                On Error GoTo ErrHandler
            Select Case Response
                Case vbYes
                    Call SaveDoc
                    Call OpenDocument
                Case vbNo
                    Call OpenDocument
            End Select
            Else
                Call OpenDocument
            End If
        frmFind.Hide
        frmReplace.Hide
        End If
        Exit Function

ErrHandler:
Exit Function

End Function
Public Function DocUnload()
        If boolnew = True And boolsave = True Then
            Response = MsgBox("  Do You Want To Save Changes?", vbQuestion + vbYesNoCancel)
            MDIForm1.CommonDialog2.CancelError = True
            On Error GoTo ErrHandler
                Select Case Response
                    Case vbYes
                        On Error GoTo ErrHandler
                        MDIForm1.CommonDialog2.Flags = &H2 'File exists
                        MDIForm1.CommonDialog2.ShowSave
                        frmOpenDoc.RichTextBox1.SaveFile MDIForm1.CommonDialog2.filename
                        boolsave = False
                        Exit Function
                        End
                    Case vbNo
                        End
                End Select
            Else
                If boolsave = True Then
                    Response = MsgBox("  Do You Want To Save Changes?", vbQuestion + vbYesNoCancel)
                    MDIForm1.CommonDialog2.CancelError = True
                    On Error GoTo ErrHandler
                Select Case Response
                    Case vbYes
                        Call SaveDoc
                        If bCannotSave = False Then
                            End
                        End If
                    Case vbNo
                        End
                End Select
                Else
                    End
                End If
        End If
ErrHandler:
Cancel = True
End Function

'==============
'Creating the spelling object

Public Function Spelling()
Dim Speller         As Object
Dim txt             As String
Dim new_txt         As String
Dim pos             As Integer

  MDIForm1.StatusBar1.Panels(1).Text = "Loading spelling object, please wait..."
  On Error GoTo OpenError
  Set Speller = CreateObject("Word.Basic")
  On Error GoTo ErrorTrap
  Screen.MousePointer = 11

  Speller.FileNew
  Speller.Insert frmOpenDoc.RichTextBox1.Text
  Screen.MousePointer = 0
  If boolnew = True Then
    MDIForm1.StatusBar1.Panels(1) = MDIForm1.CommonDialog2.filename
  Else
    MDIForm1.StatusBar1.Panels(1) = MDIForm1.CommonDialog1.filename
  End If

  Speller.ToolsSpelling
  Speller.EditSelectAll

  txt = Speller.selection()
  Speller.FileExit 2
  If Right$(txt, 1) = vbCr Then
    txt = Left$(txt, Len(txt) - 1)
    new_txt = ""
    pos = InStr(txt, vbCr)
    Do While pos > 0
    new_txt = new_txt & Left$(txt, pos - 1) & vbCrLf
    txt = Right$(txt, Len(txt) - pos)
    pos = InStr(txt, vbCr)
    Loop
    new_txt = new_txt & txt
    frmOpenDoc.RichTextBox1.Text = new_txt
    txt = ""

  End If
    MsgBox "The Spelling Check has completed "
txt = ""
    Exit Function
OpenError:

   ' MsgBox "Error" & Str$(Error.Number) & " opening word." & vbCrLf & Error.Description
ErrorTrap:
Call ErrorTrap
End Function
Public Function ErrorTrap()
MsgBox "Document has encountered an error.  Error# " + Str$(Err) + Chr(10) + Chr(13) + Chr(10) + Error$ + Chr(13) + Chr(10) + Chr(10) + "Document will continue"
End Function
Public Function NewModExisting()
        If boolsave = True Then
            Response = MsgBox("  Do You Want To Save Changes?", vbQuestion + vbYesNoCancel)
            On Error GoTo ErrHandler
        Select Case Response
            Case vbYes
                Call SaveNew
                Call NewModExisting1
                MDIForm1.mnuPaste.Enabled = True
                MDIForm1.Toolbar1.Buttons(14).Enabled = True
            Case vbNo
                Call ControlsDisabled
                Call NewModExisting1
                MDIForm1.mnuPaste.Enabled = True
                MDIForm1.Toolbar1.Buttons(14).Enabled = True
        End Select
        Else
            Call ControlsDisabled
            MDIForm1.mnuTimeDate.Enabled = True
            boolnew = True
            frmOpenDoc.SetFocus
        End If
ErrHandler:
Exit Function
End Function
Public Function OpenDocModify()
On Error GoTo ErrHandler
MDIForm1.CommonDialog2.Flags = &H2 'File exists
MDIForm1.CommonDialog2.ShowSave
frmOpenDoc.RichTextBox1.SaveFile MDIForm1.CommonDialog2.filename
boolsave = False
Call OpenDocument
Exit Function
ErrHandler:
Cancel = True
End Function

Public Function PrintDoc()
'MDIForm1.CommonDialog3.CancelError = True
'On Error GoTo ErrHandler
'MDIForm1.CommonDialog3.ShowPrinter
'X = Printer.ScaleWidth / 2
'Y = Printer.ScaleHeight / 2
'Printer.CurrentX = X
'Printer.CurrentY = Y
'Printer.Circle Step(0, 0), 1500
'Printer.FillStyle = 0
'Printer.CurrentX = X
'Printer.CurrentY = Y + 800
'For i = O To 4
'Printer.FillColor = QBColor(i)
'Printer.Circle Step(0, -800), i * 200 + 100
'Next i
'Printer.CurrentX = 0
'Printer.CurrentY = 0
'Printer.FontSize = 24
'Printer.Print frmOpenDoc.RichTextBox1.Text
'Printer.EndDoc
'ErrHandler:
'Exit Function

'Printer.Print frmOpenDoc.RichTextBox1.Text
Printer.PrintQuality = vbPRPQMedium

With frmOpenDoc.RichTextBox1
    .SaveFile MDIForm1.CommonDialog1.filename, rtfRTF
    .SelStart = 0
 On Error Resume Next
    While Len(.Text) > 0
        Screen.MousePointer = 11
        .SelLength = InStr(.SelStart + 1, .Text, vbCrLf) + 1
        Printer.Font.Name = .SelFontName
        Printer.Font.Size = .SelFontSize
        Printer.Font.Bold = .SelBold
        Printer.Print Mid(.SelText, 1, .SelLength)
        .SelText = ""
        .SelStart = 0
    Wend

    .LoadFile MDIForm1.CommonDialog1.filename, rtfRTF
End With

Printer.EndDoc
Screen.MousePointer = 0
End Function

Public Function CloseModExistNewDoc()
        If boolsave = True Then
            Response = MsgBox("  Do You Want To Save Changes?", vbQuestion + vbYesNoCancel)
            On Error GoTo ErrHandler
        Select Case Response
        Case vbYes
            Call SaveDoc
            If bCannotSave = False Then
                Call CloseDocument
            End If
        Case vbNo
            Call CloseDocument
        End Select
        Else
            Call ControlsDisabled
            MDIForm1.mnuTimeDate.Enabled = True
            frmOpenDoc.RichTextBox1.Visible = True
            frmOpenDoc.SetFocus
        End If
ErrHandler:
Exit Function
End Function
Public Sub CheckSoftware(X As Form)
Dim SaveTitle$
If App.PrevInstance Then
  SaveTitle$ = App.Title
  MsgBox "Document is already running." + Chr(10) + Chr(13) + Chr(10) + "Please close the other instance of Document, before running a new instance."
  App.Title = ""
  X.Caption = ""
  AppActivate SaveTitle$
  SendKeys "%{ENTER}", True
  End
End If
End Sub
Public Function RichTextKeyDown()
        If boolnew = True Then
            Dim currLine&
            On Local Error Resume Next
            currLine& = SendMessageLong(frmOpenDoc.RichTextBox1.hwnd, EM_LINEFROMCHAR, -1&, 0&) + 1
            With MDIForm1
                .StatusBar1.Panels(4) = Format$(currLine&, "##,###")
                .Toolbar1.Buttons(4).Enabled = True
                .mnuSaveAs.Enabled = True
                .Combo2.Enabled = True
                .mnuPrint.Enabled = True: .Toolbar1.Buttons(6).Enabled = True
                .mnuCut.Enabled = True: .Toolbar1.Buttons(12).Enabled = True
                .mnuCopy.Enabled = True: .Toolbar1.Buttons(13).Enabled = True
                .mnuPaste.Enabled = True: .Toolbar1.Buttons(14).Enabled = True
                .mnuFind.Enabled = True
                .mnuReplace.Enabled = True
                .Toolbar1.Buttons(18).Enabled = True
                .mnuFormatText.Enabled = True
                .mnuWordCount.Enabled = True
                .mnuSpelling.Enabled = True: .Toolbar1.Buttons(16).Enabled = True
                .Toolbar1.Buttons(22).Enabled = True
                .Toolbar1.Buttons(23).Enabled = True
                .Toolbar1.Buttons(24).Enabled = True
                .Toolbar1.Buttons(25).Enabled = True
                .Toolbar1.Buttons(29).Enabled = True
                .Toolbar1.Buttons(30).Enabled = True
                .Toolbar1.Buttons(31).Enabled = True
                .mnuSelectAll.Enabled = True
                .mnuTimeDate.Enabled = True
                boolsave = True
            End With
        Else
            On Local Error Resume Next
            currLine& = SendMessageLong(frmOpenDoc.RichTextBox1.hwnd, EM_LINEFROMCHAR, -1&, 0&) + 1
            With MDIForm1
                .StatusBar1.Panels(4) = Format$(currLine&, "##,###")
                .Toolbar1.Buttons(4).Enabled = True: .mnuSaveAs.Enabled = True
                .Toolbar1.Buttons(3).Enabled = True: .mnuSave.Enabled = True
                .Combo2.Enabled = True
                .mnuPrint.Enabled = True: .Toolbar1.Buttons(6).Enabled = True
                .mnuCut.Enabled = True: .Toolbar1.Buttons(12).Enabled = True
                .mnuCopy.Enabled = True: .Toolbar1.Buttons(13).Enabled = True
                .mnuPaste.Enabled = True: .Toolbar1.Buttons(14).Enabled = True
                .mnuFind.Enabled = True
                .mnuReplace.Enabled = True
                .Toolbar1.Buttons(18).Enabled = True
                .mnuFormatText.Enabled = True
                .mnuWordCount.Enabled = True
                .mnuSpelling.Enabled = True: .Toolbar1.Buttons(16).Enabled = True
                .Toolbar1.Buttons(22).Enabled = True
                .Toolbar1.Buttons(23).Enabled = True
                .Toolbar1.Buttons(24).Enabled = True
                .Toolbar1.Buttons(25).Enabled = True
                .Toolbar1.Buttons(29).Enabled = True
                .Toolbar1.Buttons(30).Enabled = True
                .Toolbar1.Buttons(31).Enabled = True
                .mnuSelectAll.Enabled = True
                .mnuTimeDate.Enabled = True
                boolsave = True
                End With
        End If
End Function
Public Function CloseDocument()
Call ControlsDisabled
boolnew = True
With frmOpenDoc
    .Visible = True
    .RichTextBox1.Visible = True
    .RichTextBox1.Enabled = True
    .WindowState = 0
    .SetFocus
    .Width = Screen.Width * 0.89 ' Set width of form.
    .Height = Screen.Height * 0.61   ' Set height of form.            frmOpenDoc.Top = (Screen.Height - Height) / 20 ' Center form vertically.
    .Caption = "New Document"
End With

MDIForm1.StatusBar1.Panels(1).Text = "Create a new Document"
MDIForm1.mnuTimeDate.Enabled = True
MDIForm1.Combo2.Enabled = True
End Function
Public Function NewModExisting1()
boolnew = True
MDIForm1.Combo2.Enabled = True
MDIForm1.mnuTimeDate.Enabled = True
MDIForm1.StatusBar1.Panels(1).Text = "Create a new Document"

With frmOpenDoc
    .Visible = True
    .WindowState = 0
    .SetFocus
    .RichTextBox1.Enabled = True
 '   .Width = Screen.Width * 0.89 ' Set width of form.
 '   .Height = Screen.Height * 0.61   ' Set height of form.
 '   .Top = (Screen.Height - Height) / 20 ' Center form vertically.
    .Caption = "New Document"
End With

End Function

Public Function CloseModExisting1()
Call ControlsDisabled
boolnew = False
'MDIForm1.Combo2.Enabled = True
MDIForm1.StatusBar1.Panels(1).Text = "Create a new Document"
With frmOpenDoc
    .Visible = False
    .RichTextBox1.Visible = False
    .WindowState = 0
    .Width = Screen.Width * 0.89 ' Set width of form.
    .Height = Screen.Height * 0.61   ' Set height of form.
    .Top = (Screen.Height - Height) / 20 ' Center form vertically.
    .Caption = "New Document"
End With

End Function

Public Function CloseNew1()
MDIForm1.mnuTimeDate.Enabled = True
MDIForm1.Combo2.Enabled = True
MDIForm1.StatusBar1.Panels(1).Text = "Create New Document"
With frmOpenDoc
    .Visible = True
    .RichTextBox1.Visible = True
    .RichTextBox1.Enabled = True
    .Width = Screen.Width * 0.89 ' Set width of form.
    .Height = Screen.Height * 0.61   ' Set height of form.            frmOpenDoc.Top = (Screen.Height - Height) / 400 ' Center form vertically.
    .Caption = "New Document"
End With

End Function